#lang racket/base
(require racket/class
         (only-in racket/function const)
         (prefix-in serv: "server.rkt")
         (only-in racket/list rest first last)
         "server-base-data.rkt"
         (only-in racket/bool symbol=?)
         racket/contract)

(provide functional-server-module<%>
         effectful-server-module<%>
         make-server/functional
         make-server/functional/start
         make-server/effectful
         make-server/effectful/start
         debug
         (rename-out [serv:debug-port debug-port])
         empty-package
         fserv%
         eserv%
         server%)

(define debug serv:debug)

(define functional-server-module<%>
  (interface ()
    ;; id msg -> functional-server-module<%> package
    on-msg
    ;; -> functional-server-module<%> package
    on-tick
    ;; id -> functional-server-module<%> package
    on-new
    ;; id -> functional-server-module<%> package
    on-disconnect))
(define effectful-server-module<%>
  (interface (functional-server-module<%>) ;; none of these return the functional-server-module<%>
    ;; -> Boolean
    next-state-ready?
    ;; effectful-server-module<%>(class) -> effectful-server-module<%>(object) package 
    transition))
(define empty-package (package '() '()))
(define fserv%
  (class* object% (functional-server-module<%>)
    (define/public (on-msg _ __ ___)
      (values this
              empty-package))
    (define/public (on-tick _)
      (values this
              empty-package))
    (define/public (on-new _)
      (values this
              empty-package))
    (define/public (on-disconnect _)
      (values this
              empty-package))
    (super-new)))
(define eserv%
  (class* object% (effectful-server-module<%>)
    (define/public (on-msg _ __ ___)
      empty-package)
    (define/public (on-tick _)
      empty-package)
    (define/public (on-new _)
      empty-package)
    (define/public (on-disconnect _)
      empty-package)
    (define/public (next-state-ready?)
      #f)
    (define/public (transition _%)
      (error "no transition"))
    (super-new)))
    

(define (make-server/functional init 
                                #:port [port serv:PORT] 
                                #:hostname [hostname #f])
  (make-server 'functional init #:port port #:hostname hostname))
(define (make-server/functional/start init
                                      #:port [port serv:PORT]
                                      #:hostname [hostname #f])
  (make-server/start 'functional init #:port port #:hostname hostname))

(define (make-server/effectful init [states null] 
                               #:port [port serv:PORT] 
                               #:hostname [hostname #f])
  (make-server 'effectful init states #:port port #:hostname hostname))
(define (make-server/effectful/start init [states null]
                                     #:port [port serv:PORT]
                                     #:hostname [hostname #f])
  (make-server/start 'effectful init states #:port port #:hostname hostname))

;; (or 'effectful 'functional) server-module<%>[object] (listof effectful-server-module<%>[class]) -> server%
;; creates a server
(define (make-server type init [states null] #:port [port serv:PORT] ;; port number
                     #:hostname [hostname #f]) ;; (or string #f)
  (new server% [type type] [init init] [state states] [port port]))

;; identical to make-server, but starts the server as well
(define (make-server/start type init [states null] #:port [port serv:PORT] #:hostname [hostname #f])
  (define s (make-server type init states #:port port #:hostname hostname))
  (send s start)
  s)



;; class for a server
;; init:
;;      type (or 'effectful 'functional)
;;      init server-module
;;      state (or (listof effectful-server-module<%>) functional-server-module<%>)
;;      [port number]
(define server%
  (class object%
    (super-new)
    (inspect #f)
    (init type init [state null] [port serv:PORT] [max-wait serv:MAX-WAIT])
    ;; macro to shorten state functions
    (define-syntax clause
      (syntax-rules ()
        [(_ message ...)
         (cond [(effectful?)
                (add-package (send current-state message ...))
                (may-transition)]
               [else
                 (define-values (state package)
                   (send current-state message ...))
                 (set! current-state state)
                 (add-package package)])]))
    
    ;; internal bindings
    ;; -------------------------------------------------------------------------
    (define in-port port)
    (define in-max-wait max-wait)
    (define states state)
    (define mode type)
    (define current-state init)
    (define running (make-parameter #f))
    
    ;; state functions
    ;; -------------------------------------------------------------------------
    ;; number -> (void)
    (define on-c (λ (id) (clause on-new id)))
    ;; number sexpr -> (void)
    (define on-msg (λ (id msg) (clause on-msg id msg)))
    ;; number -> (void)
    (define on-d (λ (id) (clause on-disconnect id)))
    ;; -> (void)
    (define on-t (λ () (clause on-tick)))
    
    ;; private functions
    ;; -------------------------------------------------------------------------
    
    ;; package -> (void)
    ;; adds the package to the oubout que
    (define/private (add-package p)
      (for ([m (package-msgs p)])
        (add-outbound m))
      (for ([d (package-drops p)])
        (serv:debug-msg d " was requested" " to be dropped")
        (add-kill d)))
    
    ;; -> (void)
    ;; transitions states if ready and available
    (define/private (may-transition)
      (when (and (not (null? states))
                 (send current-state next-state-ready?))
        
        (serv:debug-msg "transitioning...")
        (define-values (state package)
          (send current-state transition (first states)))
        (set! current-state state)
        (serv:debug-msg "transitioned!")
        
        (add-package package)
        (rotate-states)))
    
    ;; -> (void)
    ;; rotates the states for transitioning
    (define/private (rotate-states)
      (set! states (append (rest states) (list (first states)))))
    
    ;; interface functions
    ;; -------------------------------------------------------------------------
    ;; -> number
    (define/public (get-port)
      in-port)
    
    ;; -> number
    (define/public (get-max-wait)
      in-max-wait)
    
    ;; -> boolean
    ;; is the server running
    (define/public (running?)
      running)
    
    ;; -> boolean
    ;; is this server effectful
    (define/public (effectful?)
      (symbol=? mode 'effectful))
    
    ;; -> boolean
    ;; is this server functional?
    (define/public (functional?)
      (symbol=? mode 'functional))
    
    ;; -> [Or 'functional 'effectful]
    ;; gets the type
    (define/public (get-mode)
      mode)
    
    ;; -> server
    ;; gets current state
    (define/public (get-state)
      current-state)
    
    ;; server.rkt wrapings
    ;; -------------------------------------------------------------------------
    ;; wraping for add-outbound
    (define/public (add-outbound m)
      (when (debug)
        (serv:add-outbound m)))
    ;; wraping for add-kill
    (define/public (add-kill id)
      (when (debug)
        (serv:add-kill id)))
    ;; wraping for CON-QUE
    (define/public (get-connections)
      (when (debug)
        serv:CON-QUE))
    ;; wrapping for CUR-ID
    (define/public (total-connection-count)
      (when (debug)
        serv:CUR-ID))
    ;; counts number of connections
    (define/public (connection-count)
      (when (debug)
        (length (get-connections))))
    ;; force kills the server
    (define/public (force-kill)
      (serv:force-kill))
    
    ;; starting and stoping server
    ;; -------------------------------------------------------------------------
    ;; -> 
    (define server-stop (const (void)))
    
    ;; ->
    (define/public (stop)
      (when (running) 
        (server-stop)
        (running #f)))
    
    ;; [port ...] -> void
    (define/public (start [port in-port])
      (unless (running)
        (set! server-stop (serv:start #:on-c on-c #:on-t on-t 
                                      #:on-msg on-msg #:on-d on-d
                                      #:port in-port #:max-wait in-max-wait))
        (running #t)))))